perm filename BIN.FAI[GEM,BGB]2 blob
sn#101498 filedate 1974-05-13 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART
C00006 00003 SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
C00009 00004
C00013 00005 SUBR(COMPFE,FACE,EDGE) COMPARE FACE EDGE 3D FOR PIERCING.
C00021 00006 SUBR(OTHERV,FACE,VERTEX) FETCH OTHER VERTEX PIERCING FACE.
C00025 00007 SUBN(KLSURV,B) KILL SURFACE VERTICES OF A BODY.
C00039 00008 SUBN(MKSURF,VERTEX) MAKE SURFACE EDGES AND VERTICES.
C00050 00009 SUBN(FIXUP1)
C00053 00010 SUBN(QHOLE,VERTEX) DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
C00055 00011 SUBR(MKCVEX)F MAKE CONVEX.
C00058 00012 GO L6
C00060 00013 SCAN FACE1'S PERIMETER VERT1 TO VERT3.
C00062 00014 SUBR(ESLURP,BODY) REMOVE UNNECESSARY EDGES.
C00065 00015 SUBR(MKBUCK,BODY) MAKE BUCKET CUBE.
C00067 00016 SUBR(ECUT,B,DX,DY,DZ)
C00070 00017 SUBR(BCUT,B,DX,DY,DZ)
C00075 00018 SUBN(FECUT,BODY) FACE EDGE CUTTING.
C00078 00019
C00081 ENDMK
C⊗;
TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART
.INSERT MN
EXTERN VCW,VCCW,ECCW,VERIFY
EXTERN FACOEF,ESPLIT,INVERT
EXTERN GLUEE,LINKED,MKEV,MKFE
EXTERN WITH3D,SOLANG
EXTERN MKB,MKF,MKE,MKV,MKFRAME,WING
EXTERN OTHER,EVERT,FCCW,FCW
EXTERN DPYBUF,DPYSET,DPYOUT
EXTERN QFEV,KLFE,ECOEF,ECW
↓SURBIT←←1B2 ;VERTEX ON SURFACE.
↓OKBIT←←2B2
DEFINE QFACE(Q,V){CDR Q,7(V)}
DEFINE QFACE.(Q,V){DAP Q,7(V)}
DEFINE NAF (Q,E){CAR Q,-1(E)}
DEFINE NAF.(Q,E){DIP Q,-1(E)}
DEFINE PAF (Q,E){CDR Q,-1(E)}
DEFINE PAF.(Q,E){DAP Q,-1(E)}
DEFINE JALT(A,B){ALT. A,B↔ALT. B,A}
DEFINE JALTV(V,V.){ALT. V,V.↔ALT. V.,V
MOVSI XWC(V)↔HRRI XWC(V.)↔BLT ZWC(V.)}
DECLARE{FNEXT,ENEXT}
↓PZ ←←1B28
↓NZ ←←1B29
;BEAD FORMAT, BEADS LINK EDGES & WINDOWS FOR THE SAKE OF 2-D SORTING.
LEFT (WNBL,0) ;WINDOW'S BEAD LIST.
RIGHT(EDBL,0) ;EDGE'S BEAD LIST.
LEFT (WBEAD,1) ;WINDOW OF A BEAD.
RIGHT(EBEAD,1) ;EDGE OF A BEAD.
;SORT-WINDOW NODE FORMAT.
PENCNT ←← -3 ;PENETRATING FACE COUNT.
SURCNT ←← -2 ;SURROUNDING FACE COUNT.
EDGCNT ←← -1 ;EDGE COUNT.
;SWINDO PDL 0 ;PREVIOUS SWINDO.
;NFACE,,PFACE 1 ;SUROUNDER FACE LIST,,PENETRATOR FACE LIST.
; NED,,PED 2 ;LAST EDGE BEAD,,FIRST EDGE BEAD.
XLO←←3 ↔ XHI←← 4 ;WINDOW'S BOUNDARIES
YLO←←5 ↔ YHI←← 6 ;IN FLOATING FORMAT.
; VCNT,,CCW 7 ;VERTEX LIST THRU CCW LINKS.
;CUTFLG ←← 8 ;0 IN X, -1 IN Y.
SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
COMMENT .-----------------------------------------------------------.
L0: LAC 1,B1↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1)
LAC 1,B2↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1)
LAC 1,B1↔PVT 1,1↔CAMN 1,B1↔GO .+3↔SETZM ZPP(1)↔GO .-4
LAC 1,B2↔PVT 1,1↔CAMN 1,B2↔GO .+3↔SETZM ZPP(1)↔GO .-4
CALL(FESORT,B1,B2) ;FACE EDGE 3-D SPACE SORT.
;....................................................................
L3A: ;OUTSTR[ASCIZ/END OF FACE-EDGE COMPARES..../]↔CRLF
L3: CALL(GETSURV,B1)↔GO L4
CALL(GETSURV,B2)↔GO L4↔GO L5
L4: CALL(QHOLE,1) ;CHECK OUT A POTENTIAL HOLE.
GO L3 ;NO HOLE YET.
; OUTSTR[ASCIZ/FOUND HOLE.../]↔CRLF
CALL(KLSURV,B1) ;HOLE FACE WAS PYRAMID'ED.
CALL(KLSURV,B2) ;START OVER.
GO L0
L5: CALL(MKB,[0])↔DAC 1,BODY0
CALL(MKFRAME)↔LAC 2,BODY0↔ALT2. 1,2
LAC 1,B1
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(MKSURF,1,1)
POP P,1↔GO .-3]
LAC 1,B2
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(MKSURF,1,1)
POP P,1↔GO .-3]
L6: CALL(FIXUP1)
CALL(KLBFEV↑,B1)
CALL(KLBFEV↑,B2)
LAC 1,BODY0↔POP2J
ENDR BIN;3/7/73(BGB)-------------------------------------------------
BODY0: 0
SUBR(BUN,B1,B2) BODY UNION.
COMMENT .-----------------------------------------------------------.
CALL(EVERT,B2)↔CALL(EVERT,B1)
CALL(BIN,B1,B2)
PUSHP 1↔CALL(EVERT,1) ;SAVE RESULT.
POPP 1↔POP2J ;RETURN RESULT.
ENDR BUN;3/10/73(BGB)------------------------------------------------
SUBR(BSUB,B1,B2) BODY SUBTRACTION BNEW ← (B1-B2).
COMMENT .-----------------------------------------------------------.
CALL(EVERT,B2)
CALL(BIN,B1,B2)
POP2J
ENDR BSUB;3/10/73(BGB)-----------------------------------------------
SUBN(FESORT,B1,B2) ;COMPARE FACES AND EDGES FOR INTERSECTIONS.
COMMENT .---------------------------------------------------------------------.
;COUNT THE NUMBER OF COMPFE CALLS.
SETZ↔LAC 1,B2↔PED 1,1↔CAME 1,B2↔AOJA .-2↔PUSHP
SETZ↔LAC 1,B1↔PED 1,1↔CAME 1,B1↔AOJA .-2↔PUSHP
SETZ↔LAC 1,B2↔PFACE 1,1↔CAME 1,B2↔AOJA .-2↔PUSHP
SETZ↔LAC 1,B1↔PFACE 1,1↔CAME 1,B1↔AOJA .-2↔PUSHP
POPP 1↔POPP 2↔POPP 3↔POPP 4
IMUL 1,4↔IMUL 2,3↔ADD 1,2
;COMPARE ALL THE EDGES OF ONE WITH ALL THE FACES OF THE OTHER.
LAC 1,B1↔LAC 2,B2
PFACE 2,2↔CAME 2,B2↔GO[
PED 1,1↔CAMN 1,B1↔GO .-2↔TESTZ 1,100↔GO @.
CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO @.]
PFACE 1,1↔CAME 1,B1↔GO[
PED 2,2↔CAMN 2,B2↔GO .-2↔TESTZ 2,100↔GO @.
CALL(COMPFE,1,2)↔POP P,2↔POP P,1↔GO @.]
POP2J
; CALL(MKSWN,FACE,EDGE)
;SPLIT DIFFICULT SORT-WINDOWS UNTIL THEY ARE SIMPLE.
L1: JFCL;CALL(SWNDPY↑)
LAC 1,SWINDO↑
CDR EDGCNT(1)
CAMG ELIMIT↔GO L2
CALL(PSHSWN↑)↔GO L1
L2: CALL(XXXXXX)
CALL(POPSWN↑)
SKIPE SWINDO↔GO L1
POP2J
ELIMIT: =10
ENDR FESORT;BGB 18 APRIL 1974 -------------------------------------------------
SUBR(XXXXXX)
LAC 1,SWINDO
POP0J
ENDR XXXXXX
SUBR(COMPFE,FACE,EDGE) ;COMPARE FACE EDGE 3D FOR PIERCING.
COMMENT .------------------------------------------------------------
V2 ← PVT ⊗ Q2 < K ABOVE F,
| ENEW
____|_____________________
/ | /
/ ⊗ V FACE F /
/_________________________/
|
| E
V1 ← NVT ⊗ Q1 > K BELOW-F.
ACCUMULATORS{X,Y,Z,V1,V2,E,F}
;CHECK ARGUMENTS FOR FRESHNESS.
LAC E,EDGE↔LAC F,FACE
NVT V1,E↔PVT V2,E
QFACE 1,V1↔CAMN 1,F↔POP0J
QFACE 1,V2↔CAMN 1,F↔POP0J
;DIRECTED DISTANCE V1 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V1)
LAC 1,BB(F)↔FMP 1,YWC(V1)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V1)↔FAD 0,1↔DAC Q1#
;DIRECTED DISTANCE V2 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V2)
LAC 1,BB(F)↔FMP 1,YWC(V2)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V2)↔FAD 0,1↔DAC Q2#
;DOES EDGE PASS THRU THE PLANE OF THIS FACE.
LAC KK(F)
CAMG Q1↔GO .+3↔CAMLE Q2↔POP0J
CAML Q1↔GO .+3↔CAMGE Q2↔POP0J
FSB 0,Q1↔LAC 1,Q2↔FSB 1,Q1
FDVR 0,1↔SKIPL↔CAMLE[1.0]↔POP0J↔DAC 1
;SOLVE FOR PLANE PIERCING LOCUS.
LAC X,XWC(V1)↔LAC XWC(V2)↔FSB X↔FMP 1↔FADM X
LAC Y,YWC(V1)↔LAC YWC(V2)↔FSB Y↔FMP 1↔FADM Y
LAC Z,ZWC(V1)↔LAC ZWC(V2)↔FSB Z↔FMP 1↔FADM Z
CALL(WITH3D,F,X,Y,Z)↔POP0J
LAC E,EDGE↔LAC F,FACE↔ADD P,[XWD 4,4]
;MAKE FACE PIERCING POINT.
LAC KK(F)↔CAMLE Q1↔GO[CALL(INVERT,E)↔GO .+1]
CALL(ESPLIT,E)↔MARK 1,SURBIT
POP P,ZWC(1)↔POP P,YWC(1)↔POP P,XWC(1)↔POP P,0
QFACE. 0,1↔LAC 2,EDGE↔PED. 2,1↔POP0J
ENDR COMPFE;3/7/73---------------------------------------------------
SUBR(OTHERV,FACE,VERTEX) ;FETCH OTHER VERTEX PIERCING FACE.
COMMENT ;-----------------------------------------------------------
F1 PIERCES F2 AT V2 CASE. F2 PIERCES F1 AT V2 CASE.
______________ ________
| | | |
| F2 | | F2 |
______|......... | ______|........|_____
| ↓ . | | ↓ ↓ |
| F1 ⊗V1 ⊗V2 | | F1 ⊗V1 ⊗V2 |
|_______________↑ | |_____________________|
| | | |
|______________| |________| ;
ACCUMULATORS{F1,F2,V1,E,E0}
SAVAC(6)
LAC F2,FACE
LAC V1,VERTEX
QFACE F1,V1
;DOES F1 PIERCE F2 AT V2.
PED E,F1↔DAC E,E0
L1: CALL(VCCW,E,F1)
QFACE 0,1
CAMN 0,F2↔GO L4
SETQ(E,{ECCW,E,F1})
CAME E,E0↔GO L1
;DOES F2 PIERCE F1 AT V2.
PED E,F2↔DAC E,E0
L2: CALL(VCCW,E,F2)
CAMN 1,V1↔GO .+4
QFACE 0,1
CAMN 0,F1↔GO L4
SETQ(E,{ECCW,E,F2})
CAME E,E0↔GO L2
FATAL(OTHERV)
L4: GETAC(6)↔POP2J
ENDR OTHERV;3/8/73(BGB)----------------------------------------------
SUBN(KLSURV,B) KILL SURFACE VERTICES OF A BODY.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
LAC V,B
L: NVT V,V↔CAMN V,B↔POP1J ;SCAN FOR...
TEST V,SURBIT↔GO L ;PIERCING VERTICES.
NVT V,V↔PUSH P,V↔PVT V,V ;SAVE NEXT...
CALL(KLEV↑,V)↔POP P,V ;KILL THIS VERTEX.
GO L+1
ENDR KLSURV;3/23/73(BGB)---------------------------------------------
SUBN(OKSURV,VERTEX) MARK A SURFACE LOOP AND MAKE ITS LIST.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
LAC V,VERTEX↔PED 1,V ;FIRST EDGE.
PFACE 1,1↔DAC 1,FACE# ;FACE BELONGINF TO V.
QFACE 1,V↔DAC 1,OLDQF# ;FACE PIERCED BY V.
L: MARK V,OKBIT↔PUSH P,V
CALL(OTHERV,FACE,V) ;FOLLOW SURV LOOP ACROSS.
POP P,V
CAMN 1,VERTEX↔GO[
SETZ↔ALT2. 0,V↔POP1J] ;NIL AT END OF LIST.
ALT2. 1,V↔DAC 1,V ;OLDE V POINTS AT NEW V.
QFACE 0,V↔LAC 1,FACE ;NEXT FACE.
CAME 0,OLDQF↔LAC 1,OLDQF
DAC 0,OLDQF↔PED 0,V
SETQ(FACE,{OTHER,0,1})
GO L
ENDR OKSURV;3/23/73(BGB)---------------------------------------------
SUBN(GETSURV,B) GET AN UNMARKED SURFACE VERTEX OF A BODY OR SKIP.
COMMENT .-----------------------------------------------------------.
LAC 1,B
L: NVT 1,1
CAMN 1,B↔GO[AOS(P)↔POP1J]
TEST 1,SURBIT↔GO L
TESTZ 1,OKBIT↔GO L
POP1J
ENDR GETSURV;3/23/73(BGB)--------------------------------------------
SUBN(MKSURF,VERTEX) MAKE SURFACE EDGES AND VERTICES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{A,V1,V2,F,QF,FLG}
LAC V2,VERTEX↔PED 1,V2
SETZM FLG ;FOR ORIENTING THE FACES OF NEW EDGES.
SETQ(F,{FCCW,1,V2}) ;FACE BELONGING TO V.
QFACE QF,V2 ;FACE PIERCED BY V.
CALL(MKV,BODY0)↔JALTV(V2,1) ;MAKE FIRST SURFACE VERTEX.
L1: LAC V1,V2
SETQ(V2,{OTHERV,F,V1}) ;FOLLOW SURFACE LOOP.
CALL(ETRACE,V2)
CAMN V2,VERTEX↔GO L2
CALL(MKV,BODY0)↔JALTV(V2,1) ;MAKE SURFACE VERTEX.
L2: SETQ(A,{MKE,BODY0}) ;MAKE SURFACE EDGE.
ALT 1,V1↔NVT. 1,A↔PED. A,1 ;LINK A TO ITS VERTICES.
ALT 1,V2↔PVT. 1,A↔NED. A,1
NFACE. QF,A↔PFACE. F,A ;LINK A TO ALEIN FACES.
SKIPE FLG↔MOVSS 1(A)
CAMN V2,VERTEX↔POP1J ;TEST FOR END OF PHASE-1.
QFACE 0,V2↔LAC 1,F ;NEXT FACE.
CAMN 0,QF↔GO .+3
LAC 1,QF↔SETCMM FLG
DAC 0,QF↔PED 0,V2 ;NEW PIERCED FACE.
SETQ(F,{OTHER,0,1})↔GO L1
ENDR MKSURF;5/9/74(BGB)----------------------------------------------
SUBN(ETRACE,VERTEX) ;TRACE INTERIOR EDGES & VERTICES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,E0,V}
SAVAC(4)
LAC V,VERTEX↔PED E,V↔GO L2 ;STARTING FROM A SURV.
L0: CALL(MKV,BODY0)↔JALTV(V,1) ;MAKE INTERIOR VERTEX.
L1: PED E,V↔DAC E,E0
L2: ALT 1,E↔JUMPN 1,L3 ;IS EDGE ALREADY TRACED ?
CALL(MKE,BODY0)↔JALT(1,E) ;MAKE INTERIOR EDGE.
LAC 1(E)↔DAC 1(1) ;COPY THE FACE LINKS.
L3: CALL(OTHER,E,V)
TESTZ 1,SURBIT↔GO L4 ;DON'T TRACE SURV'S.
ALT 0,1↔JUMPN 0,L4 ;IS VERTEX ALREADY TRACED ?
ALT2. V,1↔LAC V,1↔GO L0 ;PUSH VERTEX
L4: CAMN V,VERTEX↔GO L5
SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L2
ALT2 V,V↔SKIPE V↔GO L1 ;POP VERTEX
L5: GETAC(4)↔POP1J
ENDR ETRACE;5/9/74(BGB)----------------------------------------------
SUBN(FIXUP1)
COMMENT .-----------------------------------------------------------.
;FIX UP VERTEX AND WING POINTERS OF ALL NON-SURFACE EDGES.
ACCUMULATORS{A,E,V,Q}
LAC A,BODY0
L1: PED A,A↔CAMN A,BODY0↔GO L2-1 ;POP0J
ALT E,A↔JUMPE E,L1 ;SURFACE EDGES HAVE ALT ZERO.
PVT V,E↔ ALT V,V↔PVT. V,A↔PED 0,V↔SKIPN↔PED. A,V
NVT V,E↔ ALT V,V↔NVT. V,A↔PED 0,V↔SKIPN↔PED. A,V
NCW Q,E↔ ALT Q,Q↔NCW. Q,A
PCW Q,E↔ ALT Q,Q↔PCW. Q,A
NCCW Q,E↔ALT Q,Q↔NCCW. Q,A
PCCW Q,E↔ALT Q,Q↔PCCW. Q,A↔GO L1
;....................................................................
;FIXUP2: WING TOGETHER THE SURFACE VERTEX TRIHEDRAL CORNERS.
ACCUMULATORS{U,V,A1,A2,A3}
LAC U,BODY0
L2: PVT U,U↔CAMN U,BODY0↔GO L3-1 ;POP0J
ALT V,U
TEST V,SURBIT↔GO L2
PED 1,V↔ALT A1,1
PED A2,U↔NED A3,U↔HRRZS 2(U)
CALL(WING,A1,A2)
CALL(WING,A1,A3)
CALL(WING,A2,A3)↔GO L2
;....................................................................
;FIXUP3: REPLACE ALEIN FACES WITH NATIVE FACES.
ACCUMULATORS{A,A0,E,F1,F2}
LAC A,BODY0
L3: PED A,A↔CAMN A,BODY0↔POP0J
SETZ↔ALT. 0,A ;CLEAR EDGE ALT LINKS OF BODY0.
PFACE F1,A↔PUSHJ P,L4
NFACE F1,A↔PUSHJ P,L4↔GO L3
L4: PED E,F1↔CCW 1,E ;SUB-SUBROUTINE TO REPLACE A FACE.
CAMN 1,BODY0↔POPJ P,
SETQ(F2,{MKF,BODY0})↔PED. A,F2
DAC A,A0
L5: CALL(ECCW,A,F1)
PFACE 0,A↔CAMN 0,F1↔PFACE. F2,A
NFACE 0,A↔CAMN 0,F1↔NFACE. F2,A
DAC 1,A↔CAME A,A0↔GO L5↔POPJ P,
ENDR FIXUP1;---------------------------------------------------------
SUBN(QHOLE,VERTEX) DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
CALL(OKSURV,VERTEX)
;SECOND TIME AROUND - LOOK FOR DIFFERENT Q-FACES.
LAC V,VERTEX
QFACE 1,V↔DAC 1,QF#
L1: ALT2 V,V↔JUMPE V,L2
QFACE 0,V↔CAME 0,QF↔POP1J ;EXIT NO HOLE.
GO L1
L2: SETZM A#↔SETZM N#↔SETZM X#↔SETZM Y#↔SETZM Z#
;THIRD TIME AROUND - TAKE SUM OF SOLID INTERIOR ANGLES.
LAC V,VERTEX
L3: LAC XWC(V)↔FADRM X
LAC YWC(V)↔FADRM Y
LAC ZWC(V)↔FADRM Z
AOS N↔PUSH P,V
CALL(SOLANG,V)↔FADRM 1,A
POP P,V↔ALT2 V,V
SKIPE V↔GO L3
LAC 0,N↔FLOAT↔DAC 0,N
FSBRI(2.0)↔FMPR PI↑↔FSBR A
L4: MOVMS↔CAMGE[0.01]↔POP1J ;EXIT - NO HOLE.
CALL(PYRAMID↑,QF)
LAC X↔FDVR N↔DAC XWC(1)
LAC Y↔FDVR N↔DAC YWC(1)
LAC Z↔FDVR N↔DAC ZWC(1)
PED 2,1↔DAC 2,3↔DAC 1,4
L5: MARK 2,DARKEN↔SETQ(2,{ECCW,2,4})↔CAME 2,3↔GO L5
AOS(P)↔POP1J ;SKIP EXIT - HOLE.
ENDR QHOLE;3/23/73(BGB)----------------------------------------------
SUBR(MKCVEX)F MAKE CONVEX.
COMMENT .-----------------------------------------------------------.
EXTERN MKFE,KLFE,ECOEF,VCCW,QFEV,ECW
ACCUMULATORS{F,E0,V,CNT,N,S,E,W,YMAX,YMIN,XMAX,XMIN}
;GET EXTREMA VERTICES.
MKCVX.:
LAC F,-1(P)↔DAC F,FACE1
TEST F,BBIT↔GO L0
L00: PFACE F,F↔CAMN F,-1(P)↔POP1J
PUSH P,F↔CALL(MKCVEX,F)↔POP P,F↔GO L00
L0: PED E0,F↔DAC E0,EDGE0
MOVEI CNT,1
MOVSI YMAX,400000
MOVSI XMAX,400000
SETCM YMIN,YMAX
SETCM XMIN,XMAX
L1: SETQ(V,{VCCW,E0,F})
CAMGE YMAX,YPP(V)↔GO[LAC YMAX,YPP(V)↔LAC N,V↔GO .+1]
CAMGE XMAX,XPP(V)↔GO[LAC XMAX,XPP(V)↔LAC E,V↔GO .+1]
CAMLE YMIN,YPP(V)↔GO[LAC YMIN,YPP(V)↔LAC S,V↔GO .+1]
CAMLE XMIN,XPP(V)↔GO[LAC XMIN,XPP(V)↔LAC W,V↔GO .+1]
SETQ(E0,{ECCW,E0,F})
CAME E0,EDGE0↔AOJA CNT,L1
;EXIT IF FACE1 IS ALREADY A TRIANGLE (OR LESS).
L1B: CAIG CNT,3↔POP1J
GO L6
;--------------------------------------------------------------------
;LOP OFF THE POINT WITH THE SMALLEST ANGLE ≡ LARGEST COSINE.
L5:
LAC V,-1(P)↔DAC V,VERT2
SETQ(EDGE1,{ECCW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT3
SETQ(EDGE3,{ECW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT1
CALL(ECOEF,EDGE1)
CALL(ECOEF,EDGE3)
LAC 2,EDGE1↔LAC 3,EDGE3
LAC 1,AA(2)↔FMPR 1,AA(3)
LAC 0,BB(2)↔FMPR 0,BB(3)↔FADR 1,0
LAC 0,-1(P)
SUB P,[2(2)]↔GO @2(P) ;"POP1J"
;--------------------------------------------------------------------
L6: CALL(,N,S,E,W)
MOVSI(<-2.0>)↔DAC TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5,VERT0)
SETQ(EDGE2,{MKFE,VERT1,FACE1,VERT3})
MARK 1,DARKEN+NSHARP
NFACE 1,1↔DAC 1,FACE2
CALL(FACOEF↑,FACE2)
;SCAN FACE1'S PERIMETER VERT1 TO VERT3.
HRLOI 377777↔DAC QMIN↔SETZM VERT4 ;INIT FOR CLOSEST VIOLATOR.
LAC EDGE2↔DAC EDGE0 ;INIT FOR FACE1 PERIMETER SCAN.
L2: SETQ(EDGE0,{ECCW,EDGE0,FACE1})
SETQ(VERT0,{VCCW,EDGE0,FACE1})
CAMN 1,VERT1↔GO L3
;TEST FOR VERTEX WITHIN THE TRIANGLE THAT WE ARE ABOUT TO LOP.
CALL(WITH3D,FACE2,{XWC(1)},{YWC(1)},{ZWC(1)})
GO L2 ;VERTEX IS NOT WITHIN THE TRIANGLE.
;FIND VERTEX WITHIN TRIANGLE, NEAREST VERT0.
CALL(DISTANCE↑,VERT0,VERT2)
CAML 1,QMIN↔GO L2
DAC 1,QMIN
LAC VERT0↔DAC VERT4
GO L2 ;CONTINUE THE SCAN.
;WHEN TRIANGLE IS UNVIOLATED THEN ITERATE.
L3: SKIPE VERT4↔GO L4
GO MKCVX.
;WHEN TRIANGLE HAS BEEN VIOLATED THEN RECURSE.
L4: CALL(KLFE,EDGE2)
CALL(MKFE,VERT2,FACE1,VERT4)
MARK 1,DARKEN
NFACE 1,1 ;START WORKING ON THE NEW FACE.
CALL(MKCVEX,1)
GO MKCVX. ;CONTINUE WORKING ON THE OLDE FACE.
DECLARE{FACE1,FACE2,TMP,QMIN}
DECLARE{EDGE0,EDGE1,EDGE2,EDGE3}
DECLARE{VERT0,VERT1,VERT2,VERT3,VERT4}
DEL: 0.01
ENDR MKCVEX;3/23/73(BGB)---------------------------------------------
SUBR(ESLURP,BODY) ;REMOVE UNNECESSARY EDGES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F1,F2,E1}
;Calculate face co-efficients for each face.
CALL(FACOEF↑,BODY)
;Go backwords thru ring of edges killing any darkened edges with
;co-planar faces.
LAC E1,BODY
LOOP: NED E1,E1
TEST E1,EBIT↔POP1J
PFACE F1,E1↔NFACE F2,E1
;Compare face co-efficients. Since it rans thru numerous FMPR's and
;SQRT we can't expect them to be exactly equal.
FOR @` I ε {XYZ}
< LAC I`WC(F1)↔FSBR I`WC(F2)
MOVM 0,0↔CAML 0,[0.000001]↔GO LOOP
> LAC 0,E1
;They're co-planar, now the angle on each vertex needs to be checked
;to make sure it's less than π radians.
MARK E1,DARKEN
PVT 1,E1↔DAC 1,V1
NVT 1,E1↔DAC 1,V2
;Do PVT
NCCW 1,E1↔SETQ V3,{OTHER↑,1,V1}
PCW 1,E1 ↔SETQ V4,{OTHER↑,1,V1}
PUSH P,E1
CALL(ANGL3V↑,V3,V1,V2) ;ANGL3V appears to return a value < π
MOVEM 1,T1 ;so both angles must be summed, instead
CALL(ANGL3V↑,V2,V1,V4) ;of just angle between CW and CCW edges.
FADR 1,T1
POP P,E1
CAML 1,PI↑↔GO LOOP
;Do NVT
PCCW 1,E1↔SETQ V3,{OTHER↑,1,V2}
NCW 1,E1 ↔SETQ V4,{OTHER↑,1,V2}
PUSH P,E1
CALL(ANGL3V↑,V3,V2,V1)↔DAC 1,T1
CALL(ANGL3V↑,V1,V2,V4)↔FADR 1,T1
POP P,E1
CAML 1,PI↑↔GO LOOP
;We found an unneeded edge, kill it!
NED 0,E1
PUSH P,0↔CALL(KLFE↑,E1)↔POP P,E1
GO LOOP+1
DECLARE{V1,V2,V3,V4,T1}
ENDR ESLURP;8/23/73(TVR)---------------------------------------------
SUBR(MKBUCK,BODY) ;MAKE BUCKET CUBE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V,XLO,XHI,YLO,YHI,ZLO,ZHI}
;FIND COORDINATE EXTREMA.
HRLOI XLO,377777↔HRLZI 400000
HRLOI YLO,377777↔HRLZI 400000
HRLOI ZLO,377777↔HRLZI 400000
LAC B,BODY↔LAC V,B
L1: PVT V,V↔CAMN V,B↔GO L2
CAMLE XLO,XWC(V)↔LAC XLO,XWC(V)↔CAMGE XHI,XWC(V)↔LAC XHI,XWC(V)
CAMLE YLO,YWC(V)↔LAC YLO,YWC(V)↔CAMGE YHI,YWC(V)↔LAC YHI,YWC(V)
CAMLE ZLO,ZWC(V)↔LAC ZLO,ZWC(V)↔CAMGE ZHI,ZWC(V)↔LAC ZHI,ZWC(V)
GO L1
;MAKE BOUNDS CUBE AND TRANSLATE IT TO PROPER POSITION.
L2: PUSH P,[0]
DAC XHI,0↔FSBR XHI,XLO↔FADR XLO,0↔FSC XLO,-1↔PUSH P,XLO
DAC YHI,0↔FSBR YHI,YLO↔FADR YLO,0↔FSC YLO,-1↔PUSH P,YLO
DAC ZHI,0↔FSBR ZHI,ZLO↔FADR ZLO,0↔FSC ZLO,-1↔PUSH P,ZLO
CALL(MKCUBE↑,XHI,YHI,ZHI)
DAC 1,BUCK#↔DAC 1,-3(P) ;PLACE BUCKET IN PDL.
CALL(TRANSLATE↑);"B,XLO,YLO,ZLO)" ;POSITION THE BUCKET.
LAC 1,BUCK↔POP1J
ENDR MKBUCK;1/15/74(BGB)---------------------------------------------
DECLARE{ZCUT,LIST1,FSET1,ELIST1,ELIST2,BSET1}
SUBR(ECUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2↔SETOM CUTFLG
CALL(FECUT,B)
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(KLNODE↑,FRM)↔POP4J
ENDR ECUT;3/6/74(BGB)------------------------------------------------
SUBR(FCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2↔SETZM CUTFLG
CALL(FECUT,B)
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(KLNODE↑,FRM)↔POP4J
ENDR FCUT;3/6/74(BGB)------------------------------------------------
SUBN(VMARK,BODY) ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
;CLEAR THE NZ AND PZ BITS OF ALL THE VERTICES.
SETZM PZCNT↔SETZM NZCNT
MOVEI PZ+NZ↔LAC 1,BODY
ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3
;MARK THE VERTICES AS EITHER ABOVE OR BELOW ZERO XWC.
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
SKIPGE XWC(V)↔GO L2
MARK V,PZ↔AOS PZCNT↔GO L1 ;POSITIVE.
L2: MARK V,NZ↔AOS NZCNT↔GO L1 ;NEGATIVE.
ENDR VMARK;1/11/74(BGB)---------------------------------------------
DECLARE{PZCNT,NZCNT,CUTFLG,FRM}
SUBR(BCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2
MOVEI 1↔DAC CUTFLG↔CALL(FECUT,B) ;BODY CUT +1.
L1: SKIPN 2,ELIST2↔GO[
CALL(INTRAN↑,FRM)
CALL(APTRAN↑,B,FRM)
POP4J]
ALT2 1,2↔DAC 1,ELIST2↔DAC 2,ELIST1
;KILL THE TIES THAT BIND - MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L2: SKIPN 2,ELIST1↔GO L3
ALT 1,2↔DAC 1,ELIST1
PFACE 0,2↔DAC 0,FACE1
SETQ(FACE2,{KLFE,2})
GO L2
L3: LAC 1,FACE1↔LAC 2,FACE2 ;LINK TWO NEW FACES.
MARK 1,TMPBIT↔MARK 2,TMPBIT
ALT. 1,2↔ALT. 2,1
LAC 1,FACE1↔PED 1,1↔CCW 1,1↔CAME 1,B↔GO[CALL(BATT↑,1,B)↔GO .+1]
LAC 2,FACE2↔PED 2,2↔CCW 2,2↔CAME 2,B↔GO[CALL(BATT↑,2,B)↔GO .+1]
GO L1
DECLARE{EDGE,FACE1,FACE2}
ENDR BCUT;3/6/74(BGB)------------------------------------------------
SUBN(FECUT,BODY) ;FACE EDGE CUTTING.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V2,V1,DX,DY,DZ}
;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
LAC 1,BODY↔DAC 1,EDGE#
L0: LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE ;ADVANCE ALONG EDGE RING.
CAMN 1,BODY↔POP1J ;TEST FOR END OF EDGE RING.
PVT V1,1↔NVT V2,1 ;GET VERTICES.
LAC(V1)↔EQV(V2)
TESTZ(,PZ+NZ)↔GO L0 ;TEST FOR EDGE CROSSING.
;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
SETOM FLAG ;FIRST TIME THRU FLAG -1.
SETZM ELIST1↔LAC 1,EDGE ;LIST OF VERY SHORT EDGES.
DAC 1,E↔NVT 2,1↔TEST 2,PZ
GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZ HALF-SPACE.
LAC 1,E↔NFACE 1,1
DAC 1,F0↔DAC 1,F ;FIRST FACE.
;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1: LAC 1,E
NVT V1,1↔PVT V2,1
PUSH P,V2↔PUSH P,V1 ;SAVE OLDE VERTICES.
TEST V1,PZ↔GO[
CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZZ.
SETQ(U2,{ESPLIT,E})
; MARK 1,TMPBIT
MARK 1,PZ↔PED 1,1
SKIPLE CUTFLG↔GO[
LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1
SETQ(UU2,{ESPLIT,ELIST1})
; MARK 1,TMPBIT
MARK 1,NZ↔GO .+1]
;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
POP P,V1↔POP P,V2 ;RESTORE OLDE VERTICES.
LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
MOVN 0,XWC(V1)↔FDVR 0,DX↔LAC 2,U2
FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)
;FIRST TIME ONLY.
AOSG FLAG↔GO[
LAC U2↔DAC U0
LAC UU2↔DAC UU0
GO L2]
;SPLIT FACES.
SKIPL CUTFLG↔GO[
CALL(MKFE,U2,F,U1)↔ ;MARK 1,TMPBIT
NFACE 1,1
SKIPE CUTFLG↔GO[
CALL(MKFE,UU2,1,UU1)↔ ;MARK 1,TMPBIT
GO .+1]↔GO .+1]
;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2: LAC U2↔DAC U1
LAC UU2↔DAC UU1
SETQ(F,{OTHER,E,F})
CAMN 1,F0↔GO L4
L3: SETQ(E,{ECCW,E,F})
CALL(VCCW,E,F)
TEST 1,NZ↔GO L3
GO L1
;DOUBLE CUT LAST (FIRST) FACE.
L4: SKIPGE CUTFLG↔GO L0
CALL(MKFE,U0,F,U1)↔ ;MARK 1,TMPBIT
NFACE 1,1
SKIPG CUTFLG↔GO L0
CALL(MKFE,UU0,1,UU1)↔ ;MARK 1,TMPBIT
LAC 1,ELIST1↔LAC 2,ELIST2
ALT2. 2,1
DAC 1,ELIST2↔SETZM ELIST1
GO L0
DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------
END